home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Modules / zmodn.em < prev   
Lisp/Scheme  |  1993-07-08  |  2KB  |  69 lines
  1. ;; Eulisp Module
  2. ;; Author: pab
  3. ;; File: zmodn.em
  4. ;; Date: Thu Feb 11 15:06:30 1993
  5. ;;
  6. ;; Project:
  7. ;; Description: 
  8. ;;   Numbers modulo n in feel
  9.  
  10. (defmodule zmodn
  11.   (         
  12.    eulisp0   )
  13.   ()
  14.   
  15.  
  16.   (defclass <zmodn-class> (<class>)
  17.     ((n initarg n reader zmodn-class-n))
  18.     metaclass <class>)
  19.  
  20.   (defclass <zmodn-object> (<number>)
  21.     ((z accessor zmodn-z))
  22.     metaclass <zmodn-class>)
  23.   
  24.   (defun make-zmodn-class (n)
  25.     (make <zmodn-class>
  26.       'direct-superclasses (list <zmodn-object>)
  27.       'name (make-symbol (format nil "Zmod-~a" n))
  28.       'n n))
  29.  
  30.   (defconstant *zmodn-table* (make <table> 'comparator = 'hash-function generic-hash))
  31.  
  32.   (defun find-zmodn-class (n)
  33.     (or (table-ref *zmodn-table* n)
  34.     (let ((cl (make-zmodn-class n)))
  35.       ((setter table-ref) *zmodn-table* n cl)
  36.       cl)))
  37.  
  38.   ;; i mod n
  39.   (defun make-modular-number (z n)
  40.     (make (find-zmodn-class n) 'z z))
  41.   
  42.   (defmethod initialize ((proto <zmodn-object>) lst)
  43.     (let ((i (call-next-method)))
  44.       ((setter zmodn-z) i 
  45.        (remainder (scan-args 'z lst required-argument) 
  46.           (zmodn-n i)))
  47.       i))
  48.   
  49.    (defgeneric zmodn-n (obj))
  50.  
  51.    (defmethod zmodn-n ((z <zmodn-object>))
  52.      (zmodn-class-n (class-of z)))
  53.  
  54.   ;; printing (on prin only, as this magically handles write too)
  55.   (defmethod generic-prin ((i <zmodn-object>) stream)
  56.     (format stream "~a<mod ~a>" (zmodn-z i) (zmodn-n i)))
  57.  
  58.   (defmethod binary+ ((i <zmodn-object>) (j <zmodn-object>))
  59.     (when (compatible-moduli i j)
  60.       (make-modular-number (+ (zmodn-z i) (zmodn-z j)) 
  61.                (zmodn-n i))))
  62.   
  63.   (defun compatible-moduli (n m) 
  64.     (if (= (zmodn-n n) (zmodn-n m)) t
  65.       (error "Incompatible-moduli" <number-error>)))
  66.  
  67.   ;; end module
  68.   )
  69.